home *** CD-ROM | disk | FTP | other *** search
/ The CICA Windows Explosion! / The CICA Windows Explosion! - Disc 2.iso / nt / emacssrc.zip / EMACSSRC.TAR / emacs-19.17 / src / fns.c < prev    next >
C/C++ Source or Header  |  1993-10-07  |  37KB  |  1,400 lines
  1. /* Random utility Lisp functions.
  2.    Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
  3.  
  4. This file is part of GNU Emacs.
  5.  
  6. GNU Emacs is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 1, or (at your option)
  9. any later version.
  10.  
  11. GNU Emacs is distributed in the hope that it will be useful,
  12. but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. GNU General Public License for more details.
  15.  
  16. You should have received a copy of the GNU General Public License
  17. along with GNU Emacs; see the file COPYING.  If not, write to
  18. the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
  19.  
  20.  
  21. #include "config.h"
  22.  
  23. /* Note on some machines this defines `vector' as a typedef,
  24.    so make sure we don't use that name in this file.  */
  25. #undef vector
  26. #define vector *****
  27.  
  28. #include "lisp.h"
  29. #include "commands.h"
  30.  
  31. #include "buffer.h"
  32. #include "keyboard.h"
  33. #include "intervals.h"
  34.  
  35. #ifdef STDC_HEADERS
  36. #include <stdlib.h>
  37. #endif
  38. #include "systime.h"
  39. #ifdef WINDOWSNT
  40. /* In CRT process.h which conflicts with local process.h */
  41. extern int _CRTAPI1 _getpid(void);
  42. #endif
  43. #include "fns_p.h"
  44. #include "alloca_p.h"
  45. #include "xdisp_p.h"
  46. #include "getloadavg_p.h"
  47. #include "keymap_p.h"
  48. static Lisp_Object concat _P_((int nargs, Lisp_Object *args,
  49.                                enum Lisp_Type target_type, int last_special));
  50. static Lisp_Object internal_equal _P_((register Lisp_Object o1,
  51.                                        register Lisp_Object o2, int depth));
  52. static void mapcar1 _P_((int leni, Lisp_Object *vals, Lisp_Object fn,
  53.                          Lisp_Object seq));
  54.  
  55. Lisp_Object Qstring_lessp, Qprovide, Qrequire;
  56.  
  57.  
  58. DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
  59.   "Return the argument unchanged.")
  60.   (arg)
  61.      Lisp_Object arg;
  62. {
  63.   return arg;
  64. }
  65.  
  66. DEFUN ("random", Frandom, Srandom, 0, 1, 0,
  67.   "Return a pseudo-random number.\n\
  68. On most systems all integers representable in Lisp are equally likely.\n\
  69.   This is 24 bits' worth.\n\
  70. With argument N, return random number in interval [0,N).\n\
  71. With argument t, set the random number seed from the current time and pid.")
  72.   (limit)
  73.      Lisp_Object limit;
  74. {
  75.   int val;
  76. #ifndef USE_PROTOTYPES  
  77.   extern long random ();
  78.   extern srandom ();
  79.   extern long time ();
  80. #endif
  81.  
  82.   if (EQ (limit, Qt))
  83.     srandom (getpid () + time (0));
  84.   val = random ();
  85.   if (XTYPE (limit) == Lisp_Int && XINT (limit) != 0)
  86.     {
  87.       /* Try to take our random number from the higher bits of VAL,
  88.      not the lower, since (says Gentzel) the low bits of `random'
  89.      are less random than the higher ones.  */
  90.       val &= 0xfffffff;        /* Ensure positive.  */
  91.       val >>= 5;
  92.       if (XINT (limit) < 10000)
  93.     val >>= 6;
  94.       val %= XINT (limit);
  95.     }
  96.   return make_number (val);
  97. }
  98.  
  99. /* Random data-structure functions */
  100.  
  101. DEFUN ("length", Flength, Slength, 1, 1, 0,
  102.   "Return the length of vector, list or string SEQUENCE.\n\
  103. A byte-code function object is also allowed.")
  104.   (obj)
  105.      register Lisp_Object obj;
  106. {
  107.   register Lisp_Object tail, val;
  108.   register int i;
  109.  
  110.  retry:
  111.   if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String
  112.       || XTYPE (obj) == Lisp_Compiled)
  113.     return Farray_length (obj);
  114.   else if (CONSP (obj))
  115.     {
  116.       for (i = 0, tail = obj; !NILP(tail); i++)
  117.     {
  118.       QUIT;
  119.       tail = Fcdr (tail);
  120.     }
  121.  
  122.       XFASTINT (val) = i;
  123.       return val;
  124.     }
  125.   else if (NILP(obj))
  126.     {
  127.       XFASTINT (val) = 0;
  128.       return val;
  129.     }
  130.   else
  131.     {
  132.       obj = wrong_type_argument (Qsequencep, obj);
  133.       goto retry;
  134.     }
  135. }
  136.  
  137. DEFUN ("string-equal", Fstring_equal, Sstring_equal, 2, 2, 0,
  138.   "T if two strings have identical contents.\n\
  139. Case is significant.\n\
  140. Symbols are also allowed; their print names are used instead.")
  141.   (s1, s2)
  142.      register Lisp_Object s1, s2;
  143. {
  144.   if (XTYPE (s1) == Lisp_Symbol)
  145.     XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
  146.   if (XTYPE (s2) == Lisp_Symbol)
  147.     XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
  148.   CHECK_STRING (s1, 0);
  149.   CHECK_STRING (s2, 1);
  150.  
  151.   if (XSTRING (s1)->size != XSTRING (s2)->size ||
  152.       bcmp (XSTRING (s1)->data, XSTRING (s2)->data, XSTRING (s1)->size))
  153.     return Qnil;
  154.   return Qt;
  155. }
  156.  
  157. DEFUN ("string-lessp", Fstring_lessp, Sstring_lessp, 2, 2, 0,
  158.   "T if first arg string is less than second in lexicographic order.\n\
  159. Case is significant.\n\
  160. Symbols are also allowed; their print names are used instead.")
  161.   (s1, s2)
  162.      register Lisp_Object s1, s2;
  163. {
  164.   register int i;
  165.   register unsigned char *p1, *p2;
  166.   register int end;
  167.  
  168.   if (XTYPE (s1) == Lisp_Symbol)
  169.     XSETSTRING (s1, XSYMBOL (s1)->name), XSETTYPE (s1, Lisp_String);
  170.   if (XTYPE (s2) == Lisp_Symbol)
  171.     XSETSTRING (s2, XSYMBOL (s2)->name), XSETTYPE (s2, Lisp_String);
  172.   CHECK_STRING (s1, 0);
  173.   CHECK_STRING (s2, 1);
  174.  
  175.   p1 = XSTRING (s1)->data;
  176.   p2 = XSTRING (s2)->data;
  177.   end = XSTRING (s1)->size;
  178.   if (end > XSTRING (s2)->size)
  179.     end = XSTRING (s2)->size;
  180.  
  181.   for (i = 0; i < end; i++)
  182.     {
  183.       if (p1[i] != p2[i])
  184.     return p1[i] < p2[i] ? Qt : Qnil;
  185.     }
  186.   return i < XSTRING (s2)->size ? Qt : Qnil;
  187. }
  188.  
  189.  
  190. /* ARGSUSED */
  191. Lisp_Object
  192. concat2 (s1, s2)
  193.      Lisp_Object s1, s2;
  194. {
  195. #ifdef NO_ARG_ARRAY
  196.   Lisp_Object args[2];
  197.   args[0] = s1;
  198.   args[1] = s2;
  199.   return concat (2, args, Lisp_String, 0);
  200. #else
  201.   return concat (2, &s1, Lisp_String, 0);
  202. #endif /* NO_ARG_ARRAY */
  203. }
  204.  
  205. DEFUN ("append", Fappend, Sappend, 0, MANY, 0,
  206.   "Concatenate all the arguments and make the result a list.\n\
  207. The result is a list whose elements are the elements of all the arguments.\n\
  208. Each argument may be a list, vector or string.\n\
  209. The last argument is not copied, just used as the tail of the new list.")
  210.   (nargs, args)
  211.      int nargs;
  212.      Lisp_Object *args;
  213. {
  214.   return concat (nargs, args, Lisp_Cons, 1);
  215. }
  216.  
  217. DEFUN ("concat", Fconcat, Sconcat, 0, MANY, 0,
  218.   "Concatenate all the arguments and make the result a string.\n\
  219. The result is a string whose elements are the elements of all the arguments.\n\
  220. Each argument may be a string, a list of numbers, or a vector of numbers.")
  221.   (nargs, args)
  222.      int nargs;
  223.      Lisp_Object *args;
  224. {
  225.   return concat (nargs, args, Lisp_String, 0);
  226. }
  227.  
  228. DEFUN ("vconcat", Fvconcat, Svconcat, 0, MANY, 0,
  229.   "Concatenate all the arguments and make the result a vector.\n\
  230. The result is a vector whose elements are the elements of all the arguments.\n\
  231. Each argument may be a list, vector or string.")
  232.   (nargs, args)
  233.      int nargs;
  234.      Lisp_Object *args;
  235. {
  236.   return concat (nargs, args, Lisp_Vector, 0);
  237. }
  238.  
  239. DEFUN ("copy-sequence", Fcopy_sequence, Scopy_sequence, 1, 1, 0,
  240.   "Return a copy of a list, vector or string.\n\
  241. The elements of a list or vector are not copied; they are shared\n\
  242. with the original.")
  243.   (arg)
  244.      Lisp_Object arg;
  245. {
  246.   if (NILP (arg)) return arg;
  247.   if (!CONSP (arg) && XTYPE (arg) != Lisp_Vector && XTYPE (arg) != Lisp_String)
  248.     arg = wrong_type_argument (Qsequencep, arg);
  249.   return concat (1, &arg, CONSP (arg) ? Lisp_Cons : XTYPE (arg), 0);
  250. }
  251.  
  252. static Lisp_Object
  253. concat (nargs, args, target_type, last_special)
  254.      int nargs;
  255.      Lisp_Object *args;
  256.      enum Lisp_Type target_type;
  257.      int last_special;
  258. {
  259.   Lisp_Object val;
  260.   Lisp_Object len;
  261.   register Lisp_Object tail;
  262.   register Lisp_Object this;
  263.   int toindex;
  264.   register int leni;
  265.   register int argnum;
  266.   Lisp_Object last_tail;
  267.   Lisp_Object prev;
  268.  
  269.   /* In append, the last arg isn't treated like the others */
  270.   if (last_special && nargs > 0)
  271.     {
  272.       nargs--;
  273.       last_tail = args[nargs];
  274.     }
  275.   else
  276.     last_tail = Qnil;
  277.  
  278.   for (argnum = 0; argnum < nargs; argnum++)
  279.     {
  280.       this = args[argnum];
  281.       if (!(CONSP (this) || NILP (this)
  282.         || XTYPE (this) == Lisp_Vector || XTYPE (this) == Lisp_String
  283.         || XTYPE (this) == Lisp_Compiled))
  284.     {
  285.       if (XTYPE (this) == Lisp_Int)
  286.             args[argnum] = Fnumber_to_string (this);
  287.       else
  288.         args[argnum] = wrong_type_argument (Qsequencep, this);
  289.     }
  290.     }
  291.  
  292.   for (argnum = 0, leni = 0; argnum < nargs; argnum++)
  293.     {
  294.       this = args[argnum];
  295.       len = Flength (this);
  296.       leni += XFASTINT (len);
  297.     }
  298.  
  299.   XFASTINT (len) = leni;
  300.  
  301.   if (target_type == Lisp_Cons)
  302.     val = Fmake_list (len, Qnil);
  303.   else if (target_type == Lisp_Vector)
  304.     val = Fmake_vector (len, Qnil);
  305.   else
  306.     val = Fmake_string (len, len);
  307.  
  308.   /* In append, if all but last arg are nil, return last arg */
  309.   if (target_type == Lisp_Cons && EQ (val, Qnil))
  310.     return last_tail;
  311.  
  312.   if (CONSP (val))
  313.     tail = val, toindex = -1;        /* -1 in toindex is flag we are making a list */
  314.   else
  315.     toindex = 0;
  316.  
  317.   prev = Qnil;
  318.  
  319.   for (argnum = 0; argnum < nargs; argnum++)
  320.     {
  321.       Lisp_Object thislen;
  322.       int thisleni;
  323.       register int thisindex = 0;
  324.  
  325.       this = args[argnum];
  326.       if (!CONSP (this))
  327.     thislen = Flength (this), thisleni = XINT (thislen);
  328.  
  329.       if (XTYPE (this) == Lisp_String && XTYPE (val) == Lisp_String
  330.       && ! NULL_INTERVAL_P (XSTRING (this)->intervals))
  331.     {
  332.       copy_text_properties (make_number (0), thislen, this,
  333.                 make_number (toindex), val, Qnil);
  334.     }
  335.  
  336.       while (1)
  337.     {
  338.       register Lisp_Object elt;
  339.  
  340.       /* Fetch next element of `this' arg into `elt', or break if
  341.              `this' is exhausted. */
  342.       if (NILP (this)) break;
  343.       if (CONSP (this))
  344.         elt = Fcar (this), this = Fcdr (this);
  345.       else
  346.         {
  347.           if (thisindex >= thisleni) break;
  348.           if (XTYPE (this) == Lisp_String)
  349.         XFASTINT (elt) = XSTRING (this)->data[thisindex++];
  350.           else
  351.         elt = XVECTOR (this)->contents[thisindex++];
  352.         }
  353.  
  354.       /* Store into result */
  355.       if (toindex < 0)
  356.         {
  357.           XCONS (tail)->car = elt;
  358.           prev = tail;
  359.           tail = XCONS (tail)->cdr;
  360.         }
  361.       else if (XTYPE (val) == Lisp_Vector)
  362.         XVECTOR (val)->contents[toindex++] = elt;
  363.       else
  364.         {
  365.           while (XTYPE (elt) != Lisp_Int)
  366.         elt = wrong_type_argument (Qintegerp, elt);
  367.           {
  368. #ifdef MASSC_REGISTER_BUG
  369.         /* Even removing all "register"s doesn't disable this bug!
  370.            Nothing simpler than this seems to work. */
  371.         unsigned char *p = & XSTRING (val)->data[toindex++];
  372.         *p = XINT (elt);
  373. #else
  374.         XSTRING (val)->data[toindex++] = XINT (elt);
  375. #endif
  376.           }
  377.         }
  378.     }
  379.     }
  380.   if (!NILP (prev))
  381.     XCONS (prev)->cdr = last_tail;
  382.  
  383.   return val;  
  384. }
  385.  
  386. DEFUN ("copy-alist", Fcopy_alist, Scopy_alist, 1, 1, 0,
  387.   "Return a copy of ALIST.\n\
  388. This is an alist which represents the same mapping from objects to objects,\n\
  389. but does not share the alist structure with ALIST.\n\
  390. The objects mapped (cars and cdrs of elements of the alist)\n\
  391. are shared, however.\n\
  392. Elements of ALIST that are not conses are also shared.")
  393.   (alist)
  394.      Lisp_Object alist;
  395. {
  396.   register Lisp_Object tem;
  397.  
  398.   CHECK_LIST (alist, 0);
  399.   if (NILP (alist))
  400.     return alist;
  401.   alist = concat (1, &alist, Lisp_Cons, 0);
  402.   for (tem = alist; CONSP (tem); tem = XCONS (tem)->cdr)
  403.     {
  404.       register Lisp_Object car;
  405.       car = XCONS (tem)->car;
  406.  
  407.       if (CONSP (car))
  408.     XCONS (tem)->car = Fcons (XCONS (car)->car, XCONS (car)->cdr);
  409.     }
  410.   return alist;
  411. }
  412.  
  413. DEFUN ("substring", Fsubstring, Ssubstring, 2, 3, 0,
  414.   "Return a substring of STRING, starting at index FROM and ending before TO.\n\
  415. TO may be nil or omitted; then the substring runs to the end of STRING.\n\
  416. If FROM or TO is negative, it counts from the end.")
  417.   (string, from, to)
  418.      Lisp_Object string;
  419.      register Lisp_Object from, to;
  420. {
  421.   Lisp_Object res;
  422.  
  423.   CHECK_STRING (string, 0);
  424.   CHECK_NUMBER (from, 1);
  425.   if (NILP (to))
  426.     to = Flength (string);
  427.   else
  428.     CHECK_NUMBER (to, 2);
  429.  
  430.   if (XINT (from) < 0)
  431.     XSETINT (from, XINT (from) + XSTRING (string)->size);
  432.   if (XINT (to) < 0)
  433.     XSETINT (to, XINT (to) + XSTRING (string)->size);
  434.   if (!(0 <= XINT (from) && XINT (from) <= XINT (to)
  435.         && XINT (to) <= XSTRING (string)->size))
  436.     args_out_of_range_3 (string, from, to);
  437.  
  438.   res = make_string (XSTRING (string)->data + XINT (from),
  439.              XINT (to) - XINT (from));
  440.   copy_text_properties (from, to, string, make_number (0), res, Qnil);
  441.   return res;
  442. }
  443.  
  444. DEFUN ("nthcdr", Fnthcdr, Snthcdr, 2, 2, 0,
  445.   "Take cdr N times on LIST, returns the result.")
  446.   (n, list)
  447.      Lisp_Object n;
  448.      register Lisp_Object list;
  449. {
  450.   register int i, num;
  451.   CHECK_NUMBER (n, 0);
  452.   num = XINT (n);
  453.   for (i = 0; i < num && !NILP (list); i++)
  454.     {
  455.       QUIT;
  456.       list = Fcdr (list);
  457.     }
  458.   return list;
  459. }
  460.  
  461. DEFUN ("nth", Fnth, Snth, 2, 2, 0,
  462.   "Return the Nth element of LIST.\n\
  463. N counts from zero.  If LIST is not that long, nil is returned.")
  464.   (n, list)
  465.      Lisp_Object n, list;
  466. {
  467.   return Fcar (Fnthcdr (n, list));
  468. }
  469.  
  470. DEFUN ("elt", Felt, Selt, 2, 2, 0,
  471.   "Return element of SEQUENCE at index N.")
  472.   (seq, n)
  473.      register Lisp_Object seq, n;
  474. {
  475.   CHECK_NUMBER (n, 0);
  476.   while (1)
  477.     {
  478.       if (XTYPE (seq) == Lisp_Cons || NILP (seq))
  479.     return Fcar (Fnthcdr (n, seq));
  480.       else if (XTYPE (seq) == Lisp_String
  481.            || XTYPE (seq) == Lisp_Vector)
  482.     return Faref (seq, n);
  483.       else
  484.     seq = wrong_type_argument (Qsequencep, seq);
  485.     }
  486. }
  487.  
  488. DEFUN ("member", Fmember, Smember, 2, 2, 0,
  489.   "Return non-nil if ELT is an element of LIST.  Comparison done with EQUAL.\n\
  490. The value is actually the tail of LIST whose car is ELT.")
  491.   (elt, list)
  492.      register Lisp_Object elt;
  493.      Lisp_Object list;
  494. {
  495.   register Lisp_Object tail;
  496.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  497.     {
  498.       register Lisp_Object tem;
  499.       tem = Fcar (tail);
  500.       if (! NILP (Fequal (elt, tem)))
  501.     return tail;
  502.       QUIT;
  503.     }
  504.   return Qnil;
  505. }
  506.  
  507. DEFUN ("memq", Fmemq, Smemq, 2, 2, 0,
  508.   "Return non-nil if ELT is an element of LIST.  Comparison done with EQ.\n\
  509. The value is actually the tail of LIST whose car is ELT.")
  510.   (elt, list)
  511.      register Lisp_Object elt;
  512.      Lisp_Object list;
  513. {
  514.   register Lisp_Object tail;
  515.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  516.     {
  517.       register Lisp_Object tem;
  518.       tem = Fcar (tail);
  519.       if (EQ (elt, tem)) return tail;
  520.       QUIT;
  521.     }
  522.   return Qnil;
  523. }
  524.  
  525. DEFUN ("assq", Fassq, Sassq, 2, 2, 0,
  526.   "Return non-nil if ELT is `eq' to the car of an element of LIST.\n\
  527. The value is actually the element of LIST whose car is ELT.\n\
  528. Elements of LIST that are not conses are ignored.")
  529.   (key, list)
  530.      register Lisp_Object key;
  531.      Lisp_Object list;
  532. {
  533.   register Lisp_Object tail;
  534.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  535.     {
  536.       register Lisp_Object elt, tem;
  537.       elt = Fcar (tail);
  538.       if (!CONSP (elt)) continue;
  539.       tem = Fcar (elt);
  540.       if (EQ (key, tem)) return elt;
  541.       QUIT;
  542.     }
  543.   return Qnil;
  544. }
  545.  
  546. /* Like Fassq but never report an error and do not allow quits.
  547.    Use only on lists known never to be circular.  */
  548.  
  549. Lisp_Object
  550. assq_no_quit (key, list)
  551.      register Lisp_Object key;
  552.      Lisp_Object list;
  553. {
  554.   register Lisp_Object tail;
  555.   for (tail = list; CONSP (tail); tail = Fcdr (tail))
  556.     {
  557.       register Lisp_Object elt, tem;
  558.       elt = Fcar (tail);
  559.       if (!CONSP (elt)) continue;
  560.       tem = Fcar (elt);
  561.       if (EQ (key, tem)) return elt;
  562.     }
  563.   return Qnil;
  564. }
  565.  
  566. DEFUN ("assoc", Fassoc, Sassoc, 2, 2, 0,
  567.   "Return non-nil if ELT is `equal' to the car of an element of LIST.\n\
  568. The value is actually the element of LIST whose car is ELT.")
  569.   (key, list)
  570.      register Lisp_Object key;
  571.      Lisp_Object list;
  572. {
  573.   register Lisp_Object tail;
  574.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  575.     {
  576.       register Lisp_Object elt, tem;
  577.       elt = Fcar (tail);
  578.       if (!CONSP (elt)) continue;
  579.       tem = Fequal (Fcar (elt), key);
  580.       if (!NILP (tem)) return elt;
  581.       QUIT;
  582.     }
  583.   return Qnil;
  584. }
  585.  
  586. DEFUN ("rassq", Frassq, Srassq, 2, 2, 0,
  587.   "Return non-nil if ELT is `eq' to the cdr of an element of LIST.\n\
  588. The value is actually the element of LIST whose cdr is ELT.")
  589.   (key, list)
  590.      register Lisp_Object key;
  591.      Lisp_Object list;
  592. {
  593.   register Lisp_Object tail;
  594.   for (tail = list; !NILP (tail); tail = Fcdr (tail))
  595.     {
  596.       register Lisp_Object elt, tem;
  597.       elt = Fcar (tail);
  598.       if (!CONSP (elt)) continue;
  599.       tem = Fcdr (elt);
  600.       if (EQ (key, tem)) return elt;
  601.       QUIT;
  602.     }
  603.   return Qnil;
  604. }
  605.  
  606. DEFUN ("delq", Fdelq, Sdelq, 2, 2, 0,
  607.   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
  608. The modified LIST is returned.  Comparison is done with `eq'.\n\
  609. If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
  610. therefore, write `(setq foo (delq element foo))'\n\
  611. to be sure of changing the value of `foo'.")
  612.   (elt, list)
  613.      register Lisp_Object elt;
  614.      Lisp_Object list;
  615. {
  616.   register Lisp_Object tail, prev;
  617.   register Lisp_Object tem;
  618.  
  619.   tail = list;
  620.   prev = Qnil;
  621.   while (!NILP (tail))
  622.     {
  623.       tem = Fcar (tail);
  624.       if (EQ (elt, tem))
  625.     {
  626.       if (NILP (prev))
  627.         list = Fcdr (tail);
  628.       else
  629.         Fsetcdr (prev, Fcdr (tail));
  630.     }
  631.       else
  632.     prev = tail;
  633.       tail = Fcdr (tail);
  634.       QUIT;
  635.     }
  636.   return list;
  637. }
  638.  
  639. DEFUN ("delete", Fdelete, Sdelete, 2, 2, 0,
  640.   "Delete by side effect any occurrences of ELT as a member of LIST.\n\
  641. The modified LIST is returned.  Comparison is done with `equal'.\n\
  642. If the first member of LIST is ELT, there is no way to remove it by side effect;\n\
  643. therefore, write `(setq foo (delete element foo))'\n\
  644. to be sure of changing the value of `foo'.")
  645.   (elt, list)
  646.      register Lisp_Object elt;
  647.      Lisp_Object list;
  648. {
  649.   register Lisp_Object tail, prev;
  650.   register Lisp_Object tem;
  651.  
  652.   tail = list;
  653.   prev = Qnil;
  654.   while (!NILP (tail))
  655.     {
  656.       tem = Fcar (tail);
  657.       if (! NILP (Fequal (elt, tem)))
  658.     {
  659.       if (NILP (prev))
  660.         list = Fcdr (tail);
  661.       else
  662.         Fsetcdr (prev, Fcdr (tail));
  663.     }
  664.       else
  665.     prev = tail;
  666.       tail = Fcdr (tail);
  667.       QUIT;
  668.     }
  669.   return list;
  670. }
  671.  
  672. DEFUN ("nreverse", Fnreverse, Snreverse, 1, 1, 0,
  673.   "Reverse LIST by modifying cdr pointers.\n\
  674. Returns the beginning of the reversed list.")
  675.   (list)
  676.      Lisp_Object list;
  677. {
  678.   register Lisp_Object prev, tail, next;
  679.  
  680.   if (NILP (list)) return list;
  681.   prev = Qnil;
  682.   tail = list;
  683.   while (!NILP (tail))
  684.     {
  685.       QUIT;
  686.       next = Fcdr (tail);
  687.       Fsetcdr (tail, prev);
  688.       prev = tail;
  689.       tail = next;
  690.     }
  691.   return prev;
  692. }
  693.  
  694. DEFUN ("reverse", Freverse, Sreverse, 1, 1, 0,
  695.   "Reverse LIST, copying.  Returns the beginning of the reversed list.\n\
  696. See also the function `nreverse', which is used more often.")
  697.   (list)
  698.      Lisp_Object list;
  699. {
  700.   Lisp_Object length;
  701.   register Lisp_Object *vec;
  702.   register Lisp_Object tail;
  703.   register int i;
  704.  
  705.   length = Flength (list);
  706.   vec = (Lisp_Object *) alloca (XINT (length) * sizeof (Lisp_Object));
  707.   for (i = XINT (length) - 1, tail = list; i >= 0; i--, tail = Fcdr (tail))
  708.     vec[i] = Fcar (tail);
  709.  
  710.   return Flist (XINT (length), vec);
  711. }
  712.  
  713.  
  714. DEFUN ("sort", Fsort, Ssort, 2, 2, 0,
  715.   "Sort LIST, stably, comparing elements using PREDICATE.\n\
  716. Returns the sorted list.  LIST is modified by side effects.\n\
  717. PREDICATE is called with two elements of LIST, and should return T\n\
  718. if the first element is \"less\" than the second.")
  719.   (list, pred)
  720.      Lisp_Object list, pred;
  721. {
  722.   Lisp_Object front, back;
  723.   register Lisp_Object len, tem;
  724.   struct gcpro gcpro1, gcpro2;
  725.   register int length;
  726.  
  727.   front = list;
  728.   len = Flength (list);
  729.   length = XINT (len);
  730.   if (length < 2)
  731.     return list;
  732.  
  733.   XSETINT (len, (length / 2) - 1);
  734.   tem = Fnthcdr (len, list);
  735.   back = Fcdr (tem);
  736.   Fsetcdr (tem, Qnil);
  737.  
  738.   GCPRO2 (front, back);
  739.   front = Fsort (front, pred);
  740.   back = Fsort (back, pred);
  741.   UNGCPRO;
  742.   return merge (front, back, pred);
  743. }
  744.  
  745. Lisp_Object
  746. merge (org_l1, org_l2, pred)
  747.      Lisp_Object org_l1, org_l2;
  748.      Lisp_Object pred;
  749. {
  750.   Lisp_Object value;
  751.   register Lisp_Object tail;
  752.   Lisp_Object tem;
  753.   register Lisp_Object l1, l2;
  754.   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
  755.  
  756.   l1 = org_l1;
  757.   l2 = org_l2;
  758.   tail = Qnil;
  759.   value = Qnil;
  760.  
  761.   /* It is sufficient to protect org_l1 and org_l2.
  762.      When l1 and l2 are updated, we copy the new values
  763.      back into the org_ vars.  */
  764.   GCPRO4 (org_l1, org_l2, pred, value);
  765.  
  766.   while (1)
  767.     {
  768.       if (NILP (l1))
  769.     {
  770.       UNGCPRO;
  771.       if (NILP (tail))
  772.         return l2;
  773.       Fsetcdr (tail, l2);
  774.       return value;
  775.     }
  776.       if (NILP (l2))
  777.     {
  778.       UNGCPRO;
  779.       if (NILP (tail))
  780.         return l1;
  781.       Fsetcdr (tail, l1);
  782.       return value;
  783.     }
  784.       tem = call2 (pred, Fcar (l2), Fcar (l1));
  785.       if (NILP (tem))
  786.     {
  787.       tem = l1;
  788.       l1 = Fcdr (l1);
  789.       org_l1 = l1;
  790.     }
  791.       else
  792.     {
  793.       tem = l2;
  794.       l2 = Fcdr (l2);
  795.       org_l2 = l2;
  796.     }
  797.       if (NILP (tail))
  798.     value = tem;
  799.       else
  800.     Fsetcdr (tail, tem);
  801.       tail = tem;
  802.     }
  803. }
  804.  
  805. DEFUN ("get", Fget, Sget, 2, 2, 0,
  806.   "Return the value of SYMBOL's PROPNAME property.\n\
  807. This is the last VALUE stored with `(put SYMBOL PROPNAME VALUE)'.")
  808.   (sym, prop)
  809.      Lisp_Object sym;
  810.      register Lisp_Object prop;
  811. {
  812.   register Lisp_Object tail;
  813.   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
  814.     {
  815.       register Lisp_Object tem;
  816.       tem = Fcar (tail);
  817.       if (EQ (prop, tem))
  818.     return Fcar (Fcdr (tail));
  819.     }
  820.   return Qnil;
  821. }
  822.  
  823. DEFUN ("put", Fput, Sput, 3, 3, 0,
  824.   "Store SYMBOL's PROPNAME property with value VALUE.\n\
  825. It can be retrieved with `(get SYMBOL PROPNAME)'.")
  826.   (sym, prop, val)
  827.      Lisp_Object sym;
  828.      register Lisp_Object prop;
  829.      Lisp_Object val;
  830. {
  831.   register Lisp_Object tail, prev;
  832.   Lisp_Object newcell;
  833.   prev = Qnil;
  834.   for (tail = Fsymbol_plist (sym); !NILP (tail); tail = Fcdr (Fcdr (tail)))
  835.     {
  836.       register Lisp_Object tem;
  837.       tem = Fcar (tail);
  838.       if (EQ (prop, tem))
  839.     return Fsetcar (Fcdr (tail), val);
  840.       prev = tail;
  841.     }
  842.   newcell = Fcons (prop, Fcons (val, Qnil));
  843.   if (NILP (prev))
  844.     Fsetplist (sym, newcell);
  845.   else
  846.     Fsetcdr (Fcdr (prev), newcell);
  847.   return val;
  848. }
  849.  
  850. DEFUN ("equal", Fequal, Sequal, 2, 2, 0,
  851.   "T if two Lisp objects have similar structure and contents.\n\
  852. They must have the same data type.\n\
  853. Conses are compared by comparing the cars and the cdrs.\n\
  854. Vectors and strings are compared element by element.\n\
  855. Numbers are compared by value, but integers cannot equal floats.\n\
  856.  (Use `=' if you want integers and floats to be able to be equal.)\n\
  857. Symbols must match exactly.")
  858.   (o1, o2)
  859.      register Lisp_Object o1, o2;
  860. {
  861.   return internal_equal (o1, o2, 0);
  862. }
  863.  
  864. static Lisp_Object
  865. internal_equal (o1, o2, depth)
  866.      register Lisp_Object o1, o2;
  867.      int depth;
  868. {
  869.   if (depth > 200)
  870.     error ("Stack overflow in equal");
  871. do_cdr:
  872.   QUIT;
  873.   if (EQ (o1, o2)) return Qt;
  874. #ifdef LISP_FLOAT_TYPE
  875.   if (FLOATP (o1) && FLOATP (o2))
  876.     return (extract_float (o1) == extract_float (o2)) ? Qt : Qnil;
  877. #endif
  878.   if (XTYPE (o1) != XTYPE (o2)) return Qnil;
  879.   if (XTYPE (o1) == Lisp_Cons
  880.       || XTYPE (o1) == Lisp_Overlay)
  881.     {
  882.       Lisp_Object v1;
  883.       v1 = internal_equal (Fcar (o1), Fcar (o2), depth + 1);
  884.       if (NILP (v1))
  885.     return v1;
  886.       o1 = Fcdr (o1), o2 = Fcdr (o2);
  887.       goto do_cdr;
  888.     }
  889.   if (XTYPE (o1) == Lisp_Marker)
  890.     {
  891.       return (XMARKER (o1)->buffer == XMARKER (o2)->buffer
  892.           && XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)
  893.     ? Qt : Qnil;
  894.     }
  895.   if (XTYPE (o1) == Lisp_Vector
  896.       || XTYPE (o1) == Lisp_Compiled)
  897.     {
  898.       register int index;
  899.       if (XVECTOR (o1)->size != XVECTOR (o2)->size)
  900.     return Qnil;
  901.       for (index = 0; index < XVECTOR (o1)->size; index++)
  902.     {
  903.       Lisp_Object v, v1, v2;
  904.       v1 = XVECTOR (o1)->contents [index];
  905.       v2 = XVECTOR (o2)->contents [index];
  906.       v = internal_equal (v1, v2, depth + 1);
  907.       if (NILP (v)) return v;
  908.     }
  909.       return Qt;
  910.     }
  911.   if (XTYPE (o1) == Lisp_String)
  912.     {
  913.       if (XSTRING (o1)->size != XSTRING (o2)->size)
  914.     return Qnil;
  915.       if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, XSTRING (o1)->size))
  916.     return Qnil;
  917.       return Qt;
  918.     }
  919.   return Qnil;
  920. }
  921.  
  922. DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0,
  923.   "Store each element of ARRAY with ITEM.  ARRAY is a vector or string.")
  924.   (array, item)
  925.      Lisp_Object array, item;
  926. {
  927.   register int size, index, charval;
  928.  retry:
  929.   if (XTYPE (array) == Lisp_Vector)
  930.     {
  931.       register Lisp_Object *p = XVECTOR (array)->contents;
  932.       size = XVECTOR (array)->size;
  933.       for (index = 0; index < size; index++)
  934.     p[index] = item;
  935.     }
  936.   else if (XTYPE (array) == Lisp_String)
  937.     {
  938.       register unsigned char *p = XSTRING (array)->data;
  939.       CHECK_NUMBER (item, 1);
  940.       charval = XINT (item);
  941.       size = XSTRING (array)->size;
  942.       for (index = 0; index < size; index++)
  943.     p[index] = charval;
  944.     }
  945.   else
  946.     {
  947.       array = wrong_type_argument (Qarrayp, array);
  948.       goto retry;
  949.     }
  950.   return array;
  951. }
  952.  
  953. /* ARGSUSED */
  954. Lisp_Object
  955. nconc2 (s1, s2)
  956.      Lisp_Object s1, s2;
  957. {
  958. #ifdef NO_ARG_ARRAY
  959.   Lisp_Object args[2];
  960.   args[0] = s1;
  961.   args[1] = s2;
  962.   return Fnconc (2, args);
  963. #else
  964.   return Fnconc (2, &s1);
  965. #endif /* NO_ARG_ARRAY */
  966. }
  967.  
  968. DEFUN ("nconc", Fnconc, Snconc, 0, MANY, 0,
  969.   "Concatenate any number of lists by altering them.\n\
  970. Only the last argument is not altered, and need not be a list.")
  971.   (nargs, args)
  972.      int nargs;
  973.      Lisp_Object *args;
  974. {
  975.   register int argnum;
  976.   register Lisp_Object tail, tem, val;
  977.  
  978.   val = Qnil;
  979.  
  980.   for (argnum = 0; argnum < nargs; argnum++)
  981.     {
  982.       tem = args[argnum];
  983.       if (NILP (tem)) continue;
  984.  
  985.       if (NILP (val))
  986.     val = tem;
  987.  
  988.       if (argnum + 1 == nargs) break;
  989.  
  990.       if (!CONSP (tem))
  991.     tem = wrong_type_argument (Qlistp, tem);
  992.  
  993.       while (CONSP (tem))
  994.     {
  995.       tail = tem;
  996.       tem = Fcdr (tail);
  997.       QUIT;
  998.     }
  999.  
  1000.       tem = args[argnum + 1];
  1001.       Fsetcdr (tail, tem);
  1002.       if (NILP (tem))
  1003.     args[argnum + 1] = tail;
  1004.     }
  1005.  
  1006.   return val;
  1007. }
  1008.  
  1009. /* This is the guts of all mapping functions.
  1010.  Apply fn to each element of seq, one by one,
  1011.  storing the results into elements of vals, a C vector of Lisp_Objects.
  1012.  leni is the length of vals, which should also be the length of seq. */
  1013.  
  1014. static void
  1015. mapcar1 (leni, vals, fn, seq)
  1016.      int leni;
  1017.      Lisp_Object *vals;
  1018.      Lisp_Object fn, seq;
  1019. {
  1020.   register Lisp_Object tail;
  1021.   Lisp_Object dummy;
  1022.   register int i;
  1023.   struct gcpro gcpro1, gcpro2, gcpro3;
  1024.  
  1025.   /* Don't let vals contain any garbage when GC happens.  */
  1026.   for (i = 0; i < leni; i++)
  1027.     vals[i] = Qnil;
  1028.  
  1029.   GCPRO3 (dummy, fn, seq);
  1030.   gcpro1.var = vals;
  1031.   gcpro1.nvars = leni;
  1032.   /* We need not explicitly protect `tail' because it is used only on lists, and
  1033.     1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */
  1034.  
  1035.   if (XTYPE (seq) == Lisp_Vector)
  1036.     {
  1037.       for (i = 0; i < leni; i++)
  1038.     {
  1039.       dummy = XVECTOR (seq)->contents[i];
  1040.       vals[i] = call1 (fn, dummy);
  1041.     }
  1042.     }
  1043.   else if (XTYPE (seq) == Lisp_String)
  1044.     {
  1045.       for (i = 0; i < leni; i++)
  1046.     {
  1047.       XFASTINT (dummy) = XSTRING (seq)->data[i];
  1048.       vals[i] = call1 (fn, dummy);
  1049.     }
  1050.     }
  1051.   else   /* Must be a list, since Flength did not get an error */
  1052.     {
  1053.       tail = seq;
  1054.       for (i = 0; i < leni; i++)
  1055.     {
  1056.       vals[i] = call1 (fn, Fcar (tail));
  1057.       tail = Fcdr (tail);
  1058.     }
  1059.     }
  1060.  
  1061.   UNGCPRO;
  1062. }
  1063.  
  1064. DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,
  1065.   "Apply FN to each element of SEQ, and concat the results as strings.\n\
  1066. In between each pair of results, stick in SEP.\n\
  1067. Thus, \" \" as SEP results in spaces between the values return by FN.")
  1068.   (fn, seq, sep)
  1069.      Lisp_Object fn, seq, sep;
  1070. {
  1071.   Lisp_Object len;
  1072.   register int leni;
  1073.   int nargs;
  1074.   register Lisp_Object *args;
  1075.   register int i;
  1076.   struct gcpro gcpro1;
  1077.  
  1078.   len = Flength (seq);
  1079.   leni = XINT (len);
  1080.   nargs = leni + leni - 1;
  1081.   if (nargs < 0) return build_string ("");
  1082.  
  1083.   args = (Lisp_Object *) alloca (nargs * sizeof (Lisp_Object));
  1084.  
  1085.   GCPRO1 (sep);
  1086.   mapcar1 (leni, args, fn, seq);
  1087.   UNGCPRO;
  1088.  
  1089.   for (i = leni - 1; i >= 0; i--)
  1090.     args[i + i] = args[i];
  1091.       
  1092.   for (i = 1; i < nargs; i += 2)
  1093.     args[i] = sep;
  1094.  
  1095.   return Fconcat (nargs, args);
  1096. }
  1097.  
  1098. DEFUN ("mapcar", Fmapcar, Smapcar, 2, 2, 0,
  1099.   "Apply FUNCTION to each element of SEQUENCE, and make a list of the results.\n\
  1100. The result is a list just as long as SEQUENCE.\n\
  1101. SEQUENCE may be a list, a vector or a string.")
  1102.   (fn, seq)
  1103.      Lisp_Object fn, seq;
  1104. {
  1105.   register Lisp_Object len;
  1106.   register int leni;
  1107.   register Lisp_Object *args;
  1108.  
  1109.   len = Flength (seq);
  1110.   leni = XFASTINT (len);
  1111.   args = (Lisp_Object *) alloca (leni * sizeof (Lisp_Object));
  1112.  
  1113.   mapcar1 (leni, args, fn, seq);
  1114.  
  1115.   return Flist (leni, args);
  1116. }
  1117.  
  1118. /* Anything that calls this function must protect from GC!  */
  1119.  
  1120. DEFUN ("y-or-n-p", Fy_or_n_p, Sy_or_n_p, 1, 1, 0,
  1121.   "Ask user a \"y or n\" question.  Return t if answer is \"y\".\n\
  1122. Takes one argument, which is the string to display to ask the question.\n\
  1123. It should end in a space; `y-or-n-p' adds `(y or n) ' to it.\n\
  1124. No confirmation of the answer is requested; a single character is enough.\n\
  1125. Also accepts Space to mean yes, or Delete to mean no.")
  1126.   (prompt)
  1127.      Lisp_Object prompt;
  1128. {
  1129.   register Lisp_Object obj, key, def, answer_string, map;
  1130.   register int answer;
  1131.   Lisp_Object xprompt;
  1132.   Lisp_Object args[2];
  1133.   int ocech = cursor_in_echo_area;
  1134.   struct gcpro gcpro1, gcpro2;
  1135.  
  1136.   map = Fsymbol_value (intern ("query-replace-map"));
  1137.  
  1138.   CHECK_STRING (prompt, 0);
  1139.   xprompt = prompt;
  1140.   GCPRO2 (prompt, xprompt);
  1141.  
  1142.   while (1)
  1143.     {
  1144.       cursor_in_echo_area = 1;
  1145.       message ("%s(y or n) ", XSTRING (xprompt)->data);
  1146.  
  1147.       obj = read_filtered_event (1, 0, 0);
  1148.       cursor_in_echo_area = 0;
  1149.       /* If we need to quit, quit with cursor_in_echo_area = 0.  */
  1150.       QUIT;
  1151.  
  1152.       key = Fmake_vector (make_number (1), obj);
  1153.       def = Flookup_key (map, key, Qnil);
  1154.       answer_string = Fsingle_key_description (obj);
  1155.  
  1156.       if (EQ (def, intern ("skip")))
  1157.     {
  1158.       answer = 0;
  1159.       break;
  1160.     }
  1161.       else if (EQ (def, intern ("act")))
  1162.     {
  1163.       answer = 1;
  1164.       break;
  1165.     }
  1166.       else if (EQ (def, intern ("recenter")))
  1167.     {
  1168.       Frecenter (Qnil);
  1169.       xprompt = prompt;
  1170.       continue;
  1171.     }
  1172.       else if (EQ (def, intern ("quit")))
  1173.     Vquit_flag = Qt;
  1174.  
  1175.       QUIT;
  1176.  
  1177.       /* If we don't clear this, then the next call to read_char will
  1178.      return quit_char again, and we'll enter an infinite loop.  */
  1179.       Vquit_flag = Qnil;
  1180.  
  1181.       Fding (Qnil);
  1182.       Fdiscard_input ();
  1183.       if (EQ (xprompt, prompt))
  1184.     {
  1185.       args[0] = build_string ("Please answer y or n.  ");
  1186.       args[1] = prompt;
  1187.       xprompt = Fconcat (2, args);
  1188.     }
  1189.     }
  1190.   UNGCPRO;
  1191.  
  1192.   if (! noninteractive)
  1193.     {
  1194.       cursor_in_echo_area = -1;
  1195.       message ("%s(y or n) %c", XSTRING (xprompt)->data, answer ? 'y' : 'n');
  1196.       cursor_in_echo_area = ocech;
  1197.     }
  1198.  
  1199.   return answer ? Qt : Qnil;
  1200. }
  1201.  
  1202. /* This is how C code calls `yes-or-no-p' and allows the user
  1203.    to redefined it.
  1204.  
  1205.    Anything that calls this function must protect from GC!  */
  1206.  
  1207. Lisp_Object
  1208. do_yes_or_no_p (prompt)
  1209.      Lisp_Object prompt;
  1210. {
  1211.   return call1 (intern ("yes-or-no-p"), prompt);
  1212. }
  1213.  
  1214. /* Anything that calls this function must protect from GC!  */
  1215.  
  1216. DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
  1217.   "Ask user a yes-or-no question.  Return t if answer is yes.\n\
  1218. Takes one argument, which is the string to display to ask the question.\n\
  1219. It should end in a space; `yes-or-no-p' adds `(yes or no) ' to it.\n\
  1220. The user must confirm the answer with RET,\n\
  1221. and can edit it until it as been confirmed.")
  1222.   (prompt)
  1223.      Lisp_Object prompt;
  1224. {
  1225.   register Lisp_Object ans;
  1226.   Lisp_Object args[2];
  1227.   struct gcpro gcpro1;
  1228.  
  1229.   CHECK_STRING (prompt, 0);
  1230.  
  1231.   args[0] = prompt;
  1232.   args[1] = build_string ("(yes or no) ");
  1233.   prompt = Fconcat (2, args);
  1234.  
  1235.   GCPRO1 (prompt);
  1236.   while (1)
  1237.     {
  1238.       ans = Fdowncase (Fread_string (prompt, Qnil));
  1239.       if (XSTRING (ans)->size == 3 && !strcmp (XSTRING (ans)->data, "yes"))
  1240.     {
  1241.       UNGCPRO;
  1242.       return Qt;
  1243.     }
  1244.       if (XSTRING (ans)->size == 2 && !strcmp (XSTRING (ans)->data, "no"))
  1245.     {
  1246.       UNGCPRO;
  1247.       return Qnil;
  1248.     }
  1249.  
  1250.       Fding (Qnil);
  1251.       Fdiscard_input ();
  1252.       message ("Please answer yes or no.");
  1253.       Fsleep_for (make_number (2), Qnil);
  1254.     }
  1255. }
  1256.  
  1257. DEFUN ("load-average", Fload_average, Sload_average, 0, 0, 0,
  1258.   "Return list of 1 minute, 5 minute and 15 minute load averages.\n\
  1259. Each of the three load averages is multiplied by 100,\n\
  1260. then converted to integer.\n\
  1261. If the 5-minute or 15-minute load averages are not available, return a\n\
  1262. shortened list, containing only those averages which are available.")
  1263.   ()
  1264. {
  1265.   double load_ave[3];
  1266.   int loads = getloadavg (load_ave, 3);
  1267.   Lisp_Object ret;
  1268.  
  1269.   if (loads < 0)
  1270.     error ("load-average not implemented for this operating system");
  1271.  
  1272.   ret = Qnil;
  1273.   while (loads > 0)
  1274.     ret = Fcons (make_number ((int) (load_ave[--loads] * 100.0)), ret);
  1275.  
  1276.   return ret;
  1277. }
  1278.  
  1279. Lisp_Object Vfeatures;
  1280.  
  1281. DEFUN ("featurep", Ffeaturep, Sfeaturep, 1, 1, 0,
  1282.   "Returns t if FEATURE is present in this Emacs.\n\
  1283. Use this to conditionalize execution of lisp code based on the presence or\n\
  1284. absence of emacs or environment extensions.\n\
  1285. Use `provide' to declare that a feature is available.\n\
  1286. This function looks at the value of the variable `features'.")
  1287.      (feature)
  1288.      Lisp_Object feature;
  1289. {
  1290.   register Lisp_Object tem;
  1291.   CHECK_SYMBOL (feature, 0);
  1292.   tem = Fmemq (feature, Vfeatures);
  1293.   return (NILP (tem)) ? Qnil : Qt;
  1294. }
  1295.  
  1296. DEFUN ("provide", Fprovide, Sprovide, 1, 1, 0,
  1297.   "Announce that FEATURE is a feature of the current Emacs.")
  1298.      (feature)
  1299.      Lisp_Object feature;
  1300. {
  1301.   register Lisp_Object tem;
  1302.   CHECK_SYMBOL (feature, 0);
  1303.   if (!NILP (Vautoload_queue))
  1304.     Vautoload_queue = Fcons (Fcons (Vfeatures, Qnil), Vautoload_queue);
  1305.   tem = Fmemq (feature, Vfeatures);
  1306.   if (NILP (tem))
  1307.     Vfeatures = Fcons (feature, Vfeatures);
  1308.   LOADHIST_ATTACH (Fcons (Qprovide, feature));
  1309.   return feature;
  1310. }
  1311.  
  1312. DEFUN ("require", Frequire, Srequire, 1, 2, 0,
  1313.   "If feature FEATURE is not loaded, load it from FILENAME.\n\
  1314. If FEATURE is not a member of the list `features', then the feature\n\
  1315. is not loaded; so load the file FILENAME.\n\
  1316. If FILENAME is omitted, the printname of FEATURE is used as the file name.")
  1317.      (feature, file_name)
  1318.      Lisp_Object feature, file_name;
  1319. {
  1320.   register Lisp_Object tem;
  1321.   CHECK_SYMBOL (feature, 0);
  1322.   tem = Fmemq (feature, Vfeatures);
  1323.   LOADHIST_ATTACH (Fcons (Qrequire, feature));
  1324.   if (NILP (tem))
  1325.     {
  1326.       int count = specpdl_ptr - specpdl;
  1327.  
  1328.       /* Value saved here is to be restored into Vautoload_queue */
  1329.       record_unwind_protect (un_autoload, Vautoload_queue);
  1330.       Vautoload_queue = Qt;
  1331.  
  1332.       Fload (NILP (file_name) ? Fsymbol_name (feature) : file_name,
  1333.          Qnil, Qt, Qnil);
  1334.  
  1335.       tem = Fmemq (feature, Vfeatures);
  1336.       if (NILP (tem))
  1337.     error ("Required feature %s was not provided",
  1338.            XSYMBOL (feature)->name->data );
  1339.  
  1340.       /* Once loading finishes, don't undo it.  */
  1341.       Vautoload_queue = Qt;
  1342.       feature = unbind_to (count, feature);
  1343.     }
  1344.   return feature;
  1345. }
  1346.  
  1347. _VOID_
  1348. syms_of_fns ()
  1349. {
  1350.   Qstring_lessp = intern ("string-lessp");
  1351.   staticpro (&Qstring_lessp);
  1352.   Qprovide = intern ("provide");
  1353.   staticpro (&Qprovide);
  1354.   Qrequire = intern ("require");
  1355.   staticpro (&Qrequire);
  1356.  
  1357.   DEFVAR_LISP ("features", &Vfeatures,
  1358.     "A list of symbols which are the features of the executing emacs.\n\
  1359. Used by `featurep' and `require', and altered by `provide'.");
  1360.   Vfeatures = Qnil;
  1361.  
  1362.   defsubr (&Sidentity);
  1363.   defsubr (&Srandom);
  1364.   defsubr (&Slength);
  1365.   defsubr (&Sstring_equal);
  1366.   defsubr (&Sstring_lessp);
  1367.   defsubr (&Sappend);
  1368.   defsubr (&Sconcat);
  1369.   defsubr (&Svconcat);
  1370.   defsubr (&Scopy_sequence);
  1371.   defsubr (&Scopy_alist);
  1372.   defsubr (&Ssubstring);
  1373.   defsubr (&Snthcdr);
  1374.   defsubr (&Snth);
  1375.   defsubr (&Selt);
  1376.   defsubr (&Smember);
  1377.   defsubr (&Smemq);
  1378.   defsubr (&Sassq);
  1379.   defsubr (&Sassoc);
  1380.   defsubr (&Srassq);
  1381.   defsubr (&Sdelq);
  1382.   defsubr (&Sdelete);
  1383.   defsubr (&Snreverse);
  1384.   defsubr (&Sreverse);
  1385.   defsubr (&Ssort);
  1386.   defsubr (&Sget);
  1387.   defsubr (&Sput);
  1388.   defsubr (&Sequal);
  1389.   defsubr (&Sfillarray);
  1390.   defsubr (&Snconc);
  1391.   defsubr (&Smapcar);
  1392.   defsubr (&Smapconcat);
  1393.   defsubr (&Sy_or_n_p);
  1394.   defsubr (&Syes_or_no_p);
  1395.   defsubr (&Sload_average);
  1396.   defsubr (&Sfeaturep);
  1397.   defsubr (&Srequire);
  1398.   defsubr (&Sprovide);
  1399. }
  1400.